home *** CD-ROM | disk | FTP | other *** search
/ C++ für Kids / C++ for kids.iso / SETUP / US / CBUILDER / DATA.Z / BTSCLASS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-13  |  19KB  |  741 lines
  1. //---------------------------------------------------------------------------
  2. // Borland C++Builder
  3. // Copyright (c) 1987, 1997 Borland International Inc.  All Rights Reserved.
  4. //---------------------------------------------------------------------------
  5. // BtsClass.pas
  6. //
  7. // VCL Class Browser
  8. //---------------------------------------------------------------------------
  9.  
  10. unit BtsClass;
  11.  
  12. interface
  13.  
  14. uses Windows, SysUtils, Classes, MIFiles, DB, DBTables, BtsConst, BDE;
  15.  
  16. const
  17.   fldnoNetName    = 3;  { USER table, Network Name field }
  18.  
  19. type
  20.  
  21. { Exceptions }
  22.  
  23.   EBts = class(Exception);
  24.   ENoRecords = class(EBts);
  25.   ESystemDown = class(EBts);
  26.   EInvalidField = class(EBts)
  27.   public
  28.     Field: TField;
  29.     constructor Create(AField: TField; const Msg: string);
  30.   end;
  31.   EMissingAttach = class(EInvalidField);
  32.  
  33. { Notifications }
  34.  
  35.   EDisplayOutline = class(Exception)
  36.   public
  37.     ItemCode: Double;
  38.     constructor Create(ACode: Double);
  39.   end;
  40.  
  41. { TLookupList }
  42.  
  43.   PStrItem = ^TStrItem;
  44.   TStrItem = record
  45.     FObject: TObject;
  46.     FCode: Integer;
  47.     FDesc: PChar;
  48.     FValue: string;
  49.     FString: string;
  50.   end;
  51.  
  52.   TLookupList = class(TStrings)
  53.   private
  54.     List: TList;
  55.     FCoded: Boolean;
  56.     FUseDesc: Boolean;
  57.     FTableName: string;
  58.   protected
  59.     CodeSep: string;
  60.     DescSep: string;
  61.     function NewStrItem(const S: string): PStrItem;
  62.     procedure DisposeStrItem(P: PStrItem);
  63.     function Get(Index: Integer): string; override;
  64.     function GetCount: Integer; override;
  65.     function GetObject(Index: Integer): TObject; override;
  66.     procedure Put(Index: Integer; const S: string); override;
  67.     procedure PutObject(Index: Integer; AObject: TObject); override;
  68.     function GetValue(Index: Integer): string;
  69.     function GetDesc(Index: Integer): string;
  70.     function GetCode(Index: Integer): Integer;
  71.     function GetItem(Index: Integer): string;
  72.   public
  73.     constructor Create;
  74.     destructor Destroy; override;
  75.     procedure Delete(Index: Integer); override;
  76.     procedure Insert(Index: Integer; const S: string); override;
  77.     procedure Clear; override;
  78.     function IndexOfValue(const S: string): Integer;
  79.     function IndexOfDesc(const S: string): Integer;
  80.     function IndexOfCode(ACode: Integer): Integer;
  81.     function IndexOfItem(const S: string): Integer;
  82.     function CodeToValue(ACode: Integer): string;
  83.     function ValueToCode(const AValue: string): Integer;
  84.     property Value[Index: Integer]: string read GetValue;
  85.     property Desc[Index: Integer]: string read GetDesc;
  86.     property Code[Index: Integer]: Integer read GetCode;
  87.     property Item[Index: Integer]: string read GetItem;
  88.     property UseDesc: Boolean read FUseDesc write FUseDesc;
  89.     property TableName: string read FTableName write FTableName;
  90.     property Coded: Boolean read FCoded;
  91.   end;
  92.  
  93. { TBtsUser }
  94.  
  95.   TBtsUser = class
  96.   private
  97.     FNetName: string;
  98.     FUserName: string;
  99.     FGroup: string;
  100.     FRights: TUserRights;
  101.     FRegistered: Boolean;
  102.   public
  103.     constructor Create(UserTab: TTable; GroupLook: TLookupList;
  104.       const DefRights: string);
  105.     procedure CheckRights(Value: TUserRights);
  106.     property Group: string read FGroup;
  107.     property NetName: string read FNetName;
  108.     property Rights: TUserRights read FRights;
  109.     property UserName: string read FUserName;
  110.     property Registered: Boolean read FRegistered write FRegistered;
  111.   end;
  112.  
  113. { TFieldMap }
  114.  
  115.   TFieldMap = class(TStringList)
  116.   private
  117.     function GetStatusValue(ResValue: Integer): Integer;
  118.   public
  119.     constructor Create(StatIni: TMemIniFile; const CfgSect: string);
  120.     property StatusValue[ResValue: Integer]: Integer read GetStatusValue;
  121.   end;
  122.  
  123. { TCloneDataset }
  124.  
  125.   TCloneDataset = class(TDBDataset)
  126.   private
  127.     FSourceHandle: HDBICur;
  128.     procedure SetSourceHandle(ASourceHandle: HDBICur);
  129.   protected
  130.     function CreateHandle: HDBICur; override;
  131.   public
  132.     property SourceHandle: HDBICur read FSourceHandle write SetSourceHandle;
  133.   end;
  134.  
  135. { TCloneTable }
  136.  
  137.   TCloneTable = class(TTable)
  138.   private
  139.     FSourceHandle: HDBICur;
  140.     procedure SetSourceHandle(ASourceHandle: HDBICur);
  141.   protected
  142.     function CreateHandle: HDBICur; override;
  143.   public
  144.     constructor CreateFromTable(AOwner: TComponent; Reset: Boolean);
  145.     procedure InitFromTable(SourceTable: TTable; Reset: Boolean);
  146.   end;
  147.  
  148. { TQueryField }
  149.  
  150.   TQueryField = class
  151.   protected
  152.     FQDType: TQueryDataType;
  153.     FFldNo: Integer;
  154.     FQRow: Integer;
  155.     FQText: string;
  156.     FFldName: string;
  157.     FLookupTableName: string;
  158.   public
  159.     LookupData: array[1..2] of TQueryField;
  160.     constructor Create(AQDType: TQueryDataType; AFldNo: Integer; AQText: string);
  161.     destructor Destroy; override;
  162.     procedure InitLookupData(LookupList: TLookupList;
  163.      const Example, CodeFldName, DescFldName: string; ARow, ACol: Integer);
  164.     property FldNo: Integer read FFldNo;
  165.     property FldName: string read FFldName write FFldName;
  166.     property QText: string read FQText write FQText;
  167.     property QRow: Integer read FQRow write FQRow;
  168.     property QDType: TQueryDataType read FQDType;
  169.     property LookupTableName: string read FLookupTableName write FLookupTableName;
  170.   end;
  171.  
  172. { TQueryData }
  173.  
  174.   TQueryData = class(TList)
  175.   private
  176.     function Get(Index: Integer): TQueryField;
  177.   public
  178.     procedure Empty;
  179.     destructor Destroy; override;
  180.     property Items[Index: Integer]: TQueryField read Get; default;
  181.   end;
  182.  
  183. { TQBEQuery }
  184.  
  185.   TCheckType = (ctNone, ctCheck, ctCheckPlus, ctCheckDesc, ctCheckGroup);
  186.  
  187.   TQBEQuery = class(TQuery)
  188.   private
  189.     hQry: hDBIQry;
  190.   protected
  191.     function CreateHandle: HDBICur; override;
  192.   public
  193.     constructor Create(AOwner: TComponent); override;
  194.     procedure AddExpr(const TabName, FldName: string; Row: Integer;
  195.       CheckType: TCheckType; Expr: string);
  196.   end;
  197.  
  198. { TOtlData }
  199.  
  200.   TOtlData = class(TObject)
  201.   public
  202.     ProgName: PChar;
  203.     Tester: PChar;
  204.     HasChildren: Boolean;
  205.     constructor Create(PName, TName: PChar; ChildFlag: Boolean);
  206.     destructor Destroy; override;
  207.   end;
  208.  
  209. implementation
  210.  
  211. uses DBConsts;
  212.  
  213. { EInvalidField }
  214.  
  215. constructor EInvalidField.Create(AField: TField; const Msg: string);
  216. begin
  217.   Field := AField;
  218.   inherited Create(Msg);
  219. end;
  220.  
  221. { TDisplayOutline }
  222.  
  223. constructor EDisplayOutline.Create(ACode: Double);
  224. begin
  225.   ItemCode := ACode;
  226. end;
  227.  
  228. { TLookupList }
  229.  
  230. constructor TLookupList.Create;
  231. const
  232.   SCodeSep = '|';
  233.   SDescSep = ' - ';
  234. begin
  235.   inherited Create;
  236.   List := TList.Create;
  237.   CodeSep := SCodeSep;
  238.   DescSep := SDescSep;
  239. end;
  240.  
  241. destructor TLookupList.Destroy;
  242. begin
  243.   if List <> nil then
  244.   begin
  245.     Clear;
  246.     List.Destroy;
  247.   end;
  248.   inherited Destroy;
  249. end;
  250.  
  251. function TLookupList.NewStrItem(const S: string): PStrItem;
  252. var
  253.   CodeSepPos: Integer;
  254.   ValLen: Integer;
  255. begin
  256.   CodeSepPos := Pos(CodeSep, S);
  257.   FCoded := CodeSepPos > 0;
  258.   ValLen := Pos(DescSep, S) - 1;
  259.   if (ValLen > 0) and (CodeSepPos > 0) then
  260.     Dec(ValLen, CodeSepPos - 1 + Length(CodeSep));
  261.   Result := New(PStrItem);
  262.   if FCoded then
  263.   begin
  264.     Result^.FString := Copy(S, CodeSepPos + Length(CodeSep), Length(S));
  265.     Result^.FCode := StrToInt(Copy(S, 1, CodeSepPos - 1));
  266.   end else
  267.   begin
  268.     Result^.FString := S;
  269.     Result^.FCode := -1;
  270.   end;
  271.   with Result^ do
  272.   begin
  273.     FObject := nil;
  274.     if ValLen > 0 then
  275.     begin
  276.       { Make a copy of the value part, so we can access it easily }
  277.       FValue := Copy(FString, 1 , ValLen);
  278.       { And a pointer to only the description }
  279.       FDesc := @FString[ValLen + Length(DescSep) + 1];
  280.     end else
  281.     begin
  282.       FValue := FString;
  283.       FDesc := nil;
  284.     end;
  285.   end;
  286. end;
  287.  
  288. procedure TLookupList.DisposeStrItem(P: PStrItem);
  289. begin
  290.   P.FObject.Free;
  291.   Dispose(P);
  292. end;
  293.  
  294. function TLookupList.Get(Index: Integer): string;
  295. begin
  296.   Result := PStrItem(List[Index]).FString;
  297. end;
  298.  
  299. function TLookupList.GetObject(Index: Integer): TObject;
  300. begin
  301.   Result := PStrItem(List[Index]).FObject;
  302. end;
  303.  
  304. function TLookupList.GetCount: Integer;
  305. begin
  306.   Result